Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Pascal/Snippets/Marquee/Marquee.p

Text File | 1995-08-13 | 10.0 KB | 368 lines | [TEXT/MMCC]

{

This program is based on Finder Marquee by Jordan Zimmerman.

Using the techniques in the original C program, this program is
done in Pascal.  It uses a linked lists for objects instead of
an array, and a new function was added for adding objects (Add_square).
Some of the other data structures were also changed.

This code implements a "rubber band" marquee select rect
with very smooth drawing in a manner similar to the Mac Finder.

Project includes:

Marquee.p  - Pascal source code
Marquee.µ  - Codewarrior Pascal project file.

8/13/95 - Bill Catambay, [e-mail]

}

Program Marquee;

Uses
    Types, Windows, Events, Fonts, Dialogs, TextUtils;

Type
    finder_marquee_rec =    record
        marquee_r:                Rect;    { current marquee_r }
        pin_pt:                    Point;        { mouse down point }
        current_pt:                Point;    { current mouse location }
        end;
    marquee_ptr_type = ^finder_marquee_rec;
    Highlight_rec    =    record
        bounds_r:        Rect;
        selected_flag:    boolean;
        next_rec:        ^highlight_rec;
        end;
    Highlight_ptr    = ^highlight_rec;

Var
    bounds_r:    Rect;
    mainw:        WindowPtr;
    statusw:    WindowPtr;
    is_done:    boolean;
    the_event:    EventRecord;
    menu:        menuRef;
    font_num:    integer;
    tab_ptr:    highlight_ptr;

Function selections_proc(marquee_ptr:    marquee_ptr_type): boolean;

Var
    i,qty:        integer;
    sect_r:        rect;
    tmp:        highlight_ptr;

    begin
    tmp := tab_ptr;
    while tmp <> NIL do
        begin
        if SectRect(marquee_ptr^.marquee_r, tmp^.bounds_r, sect_r) <> tmp^.selected_flag then
            begin
            selections_proc := TRUE;
            exit(selections_proc);
            end;
        tmp := tmp^.next_rec;
        end;
    selections_proc := false;
    end;

{ invert any of the highlight rects that intersect the current marquee rect }
Procedure change_selection_proc(marquee_ptr:        marquee_ptr_type;
                                old_marquee_r:        Rect);

Var
    i,qty:        integer;
    tmp:        highlight_ptr;
    sect_r:        rect;

    begin
    tmp := tab_ptr;
    while tmp <> NIL do
        begin
        if SectRect(marquee_ptr^.marquee_r, tmp^.bounds_r, sect_r) <> tmp^.selected_flag then
            begin
            tmp^.selected_flag := not tmp^.selected_flag;
            InvertRect(tmp^.bounds_r);
            end;
        tmp := tmp^.next_rec;
        end;
    end;

Function num2str(num:    integer): string;

Var
    str:    str255;

    begin
    numTostring(num,str);
    num2str := str;
    end; { of num2str }

{ outline the marquee rect in Xor gray }
Procedure draw_marquee_r(marquee_ptr: marquee_ptr_type);

Var
    pen_state: penstate;

    begin
    GetPenState(pen_state);
    PenMode(patXor);
    PenPat(qd.gray);
    FrameRect(marquee_ptr^.marquee_r);
    SetPenState(pen_state);
    end;

{ calculating the marquee rect isn't as simple as Pt2Rect.  Using Pt2Rect }
{ causes the pin point to shift around.  This function will calculate a }
{ correct marquee rect that keeps the pin point in place  }
Procedure calculate_marquee_r(marquee_ptr: marquee_ptr_type);

    begin
    if (marquee_ptr^.current_pt.h >= marquee_ptr^.pin_pt.h) &
       (marquee_ptr^.current_pt.v >= marquee_ptr^.pin_pt.v) then    { Quadrant IV }
        SetRect(marquee_ptr^.marquee_r, marquee_ptr^.pin_pt.h, marquee_ptr^.pin_pt.v, marquee_ptr^.current_pt.h + 1,
            marquee_ptr^.current_pt.v + 1)
    else if (marquee_ptr^.current_pt.h <= marquee_ptr^.pin_pt.h) &
            (marquee_ptr^.current_pt.v <= marquee_ptr^.pin_pt.v) then    { Quadrant I }
        SetRect(marquee_ptr^.marquee_r, marquee_ptr^.current_pt.h, marquee_ptr^.current_pt.v, marquee_ptr^.pin_pt.h + 1,
            marquee_ptr^.pin_pt.v + 1)
    else if (marquee_ptr^.current_pt.h >= marquee_ptr^.pin_pt.h) &
            (marquee_ptr^.current_pt.v <= marquee_ptr^.pin_pt.v) then    { Quadrant II }
        SetRect(marquee_ptr^.marquee_r, marquee_ptr^.pin_pt.h, marquee_ptr^.current_pt.v, marquee_ptr^.current_pt.h + 1,
            marquee_ptr^.pin_pt.v + 1)
    else { Quadrant III }
        SetRect(marquee_ptr^.marquee_r, marquee_ptr^.current_pt.h, marquee_ptr^.pin_pt.v, marquee_ptr^.pin_pt.h + 1,
            marquee_ptr^.current_pt.v + 1);
    end;

Procedure FinderMarqueeBegin(marquee_ptr:    marquee_ptr_type;
                            mouse_down_pt:    Point);

Var
    old_marquee_r:    rect;

    begin
    marquee_ptr^.pin_pt := mouse_down_pt;
    marquee_ptr^.current_pt := mouse_down_pt;
    calculate_marquee_r(marquee_ptr);
    change_selection_proc(marquee_ptr, marquee_ptr^.marquee_r);
    draw_marquee_r(marquee_ptr);
    end;

{ utility to make a 1 pixel thick region of the frame outline of a rect }
Procedure make_frame_region(target_rgn_h: RgnHandle;
                            frame_r: Rect;
                            work_rgn_h: RgnHandle);

    begin
    RectRgn(target_rgn_h, frame_r);
    CopyRgn(target_rgn_h, work_rgn_h);
    InsetRgn(work_rgn_h, 1, 1);
    DiffRgn(target_rgn_h, work_rgn_h, target_rgn_h);
    end;

Procedure FinderMarqueeContinue(marquee_ptr:    marquee_ptr_type;
                                new_pt:            Point);

Var
    pen_state:        PenState;
    old_marquee_r:    Rect;
    old_rgn_h:        RgnHandle;
    work_rgn_h:        RgnHandle;
    new_rgn_h:        RgnHandle;
    clip_rgn_h:        RgnHandle;
    success_flag:    boolean;

    begin
    old_rgn_h := NIL;
    work_rgn_h := NIL;
    new_rgn_h := NIL;
    clip_rgn_h := NIL;
    success_flag := false;
    { avoid flashing step 1 - do nothing if the mouse hasn't moved }
    if EqualPt(new_pt, marquee_ptr^.current_pt) then
        exit(FinderMarqueeContinue);
    clip_rgn_h := NewRgn;
    if clip_rgn_h = NIL then
        exit(FinderMarqueeContinue);    { can't find 10 bytes!  We're probably already in big trouble }
    { we'll be messing with the clip, so save it for later restoration }
    GetClip(clip_rgn_h);
    GetPenState(pen_state);
    PenMode(patXor);
    PenPat(qd.gray);
    { save the old marquee_r and setup the new one }
    old_marquee_r := marquee_ptr^.marquee_r;
    marquee_ptr^.current_pt := new_pt;
    calculate_marquee_r(marquee_ptr);
    repeat
        old_rgn_h := NewRgn;
        if old_rgn_h = NIL then
            leave;
        work_rgn_h := NewRgn;
        if work_rgn_h = NIL then
            leave;
        new_rgn_h := NewRgn;
        if new_rgn_h = NIL then
            leave;
        { generate 1 pixel thick outline regions of the old and new marquee_r }
        make_frame_region(old_rgn_h, old_marquee_r, work_rgn_h);
        make_frame_region(new_rgn_h, marquee_ptr^.marquee_r, work_rgn_h);
        { get the area in common between the old and the new }
        SectRgn(old_rgn_h, new_rgn_h, work_rgn_h);
        { set the clip to the old clip minus the common area of the old and new marquee rect }
        DiffRgn(clip_rgn_h, work_rgn_h, work_rgn_h);
        SetClip(work_rgn_h);
        if selections_proc(marquee_ptr) then
            begin
            { If there is a selection, the old marquee must be erased, the selections must be drawn, }
            { and then the new marquee can be drawn. }
            FrameRect(old_marquee_r);
            change_selection_proc(marquee_ptr, old_marquee_r);
            FrameRect(marquee_ptr^.marquee_r);
            end
        else
            begin
            { If there's no selection change, the marquee can be drawn in one step }
            { that will erase the old and draw the new. }
            UnionRgn(new_rgn_h, old_rgn_h, work_rgn_h);
            PaintRgn(work_rgn_h);
            end;
        success_flag := true;
    until success_flag;    { i.e. do once, set success_flag on exit }
    if not success_flag then
        begin
        { memory is evidently very tight, we'll have to live with flashing }
        FrameRect(old_marquee_r);
        change_selection_proc(marquee_ptr, old_marquee_r);
        FrameRect(marquee_ptr^.marquee_r);
        end;
    SetClip(clip_rgn_h);
    SetPenState(pen_state);
    if old_rgn_h <> NIL then
        DisposeRgn(old_rgn_h);
    if work_rgn_h <> NIL then
        DisposeRgn(work_rgn_h);
    if new_rgn_h <> NIL then
        DisposeRgn(new_rgn_h);
    if clip_rgn_h <> NIL then
        DisposeRgn(clip_rgn_h);
    SetPort(statusw);
    EraseRect(statusw^.portRect);
    with statusw^.portRect do
        MoveTo(left + 5, top + 10);
    textsize(9);
    textfont(font_num);
    with marquee_ptr^.marquee_r do
        drawstring(concat('Size: ',num2str(bottom - top),', ',num2str(right - left)));
    with statusw^.portRect do
        MoveTo(left + 5, top + 24);
    drawstring(concat('Mouse: ',num2str(new_pt.h),', ',num2str(new_pt.v)));
    SetPort(mainw);
    end;

{ here's the meat of the program }
{ while this example does it all in one function, }
{ you could just as easily separate the various calls and do it in the background }
Procedure do_marquee(local_pt:    Point);

Var
    marquee:    finder_marquee_rec;
    new_pt:        Point;

    begin
    FinderMarqueeBegin(@marquee, local_pt);
    while StillDown do with marquee.marquee_r do
        begin
        GetMouse(new_pt);
        FinderMarqueeContinue(@marquee, new_pt);
        end;
    draw_marquee_r(@marquee);
    end;

{ walk through our highlight rects and see if any of the selections will change. }
{ the marquee drawing must work slightly differently if there's going to be }
{ a selection change. }
{ If there's no selection change, the marquee can be drawn in one step (PaintRgn) }
{ that will erase the old and draw the new.  If there is a selection, though, the }
{ old marquee must be erased, the selections must be drawn, and then the new marquee }
{ can be drawn. }
{ draw in response to an update event }
Procedure draw_highlights;

Var
    i,qty:        integer;
    tmp:        highlight_ptr;

    begin
    EraseRect(mainw^.portRect);
    tmp := tab_ptr;
    while tmp <> NIL do
        begin
        FrameRect(tmp^.bounds_r);
        if tmp^.selected_flag then
            InvertRect(tmp^.bounds_r);
        tmp := tmp^.next_rec;
        end;
    end;

Procedure Add_square(left,top,right,bottom:    integer);

Var
    tmp:    highlight_ptr;

    begin
    new(tmp);
    SetRect(tmp^.bounds_r,left, top, right, bottom);
    tmp^.selected_flag := false;
    tmp^.next_rec := tab_ptr;
    tab_ptr := tmp;
    disposePtr(pointer(tmp));
    end;

begin
is_done := false;
MaxApplZone;
InitGraf(@qd.thePort);
InitFonts;
FlushEvents(everyEvent, 0);
InitWindows;
InitMenus;
TEInit;
InitDialogs(NIL);
InitCursor;
textsize(9);
getfnum('Monaco',font_num);
textfont(font_num);
tab_ptr := NIL;
add_square(10, 10, 42, 42);
add_square(50, 75, 82, 107);
add_square(100, 10, 132, 42);
add_square(110, 200, 142, 232);
add_square(308, 308, 340, 340);
menu := NewMenu(1, 'Finder Marquee');
InsertMenu(menu, 0);
DrawMenuBar;
SetRect(bounds_r, 50, 50, 400, 400);
mainw := NewCWindow(NIL, bounds_r, 'Press Any Key To Quit', true, noGrowDocProc, WindowPtr(-1), false, 0);
SetRect(bounds_r, 100, 410, 200, 450);
statusw := NewCWindow(NIL, bounds_r, '', true, plaindbox, NIL, false, 0);
SetPort(mainw);
while not is_done do
    if WaitNextEvent(everyEvent, the_event, GetDblTime, NIL) then
        case the_event.what of
            keyDown,
            autoKey:    is_done := true;
            updateEvt:    begin
                        BeginUpdate(mainw);
                        draw_highlights;
                        EndUpdate(mainw);
                        end;
            mouseDown:    begin
                        GlobalToLocal(the_event.where);
                        do_marquee(the_event.where);
                        end;
        {CASE}    end;
end.